home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / guile-ii.src / guile-ii / guile-src / slib / queue.scm < prev    next >
Encoding:
Text File  |  1995-04-23  |  1.9 KB  |  62 lines
  1. ;;;;     Copyright (C) 1995 Free Software Foundation, Inc.
  2. ;;;; 
  3. ;;;; This program is free software; you can redistribute it and/or modify
  4. ;;;; it under the terms of the GNU General Public License as published by
  5. ;;;; the Free Software Foundation; either version 2, or (at your option)
  6. ;;;; any later version.
  7. ;;;; 
  8. ;;;; This program is distributed in the hope that it will be useful,
  9. ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11. ;;;; GNU General Public License for more details.
  12. ;;;; 
  13. ;;;; You should have received a copy of the GNU General Public License
  14. ;;;; along with this software; see the file COPYING.  If not, write to
  15. ;;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ;;;; 
  17.  
  18.  
  19.  
  20. ;;; Based on the interface to 
  21. ;;;
  22. ;;; "queue.scm"  Queues/Stacks for Scheme 
  23. ;;;  Written by Andrew Wilcox (awilcox@astro.psu.edu) on April 1, 1992.
  24. ;;;
  25.  
  26. (define queue:tag (cons 'queue-tag '()))
  27.  
  28. (define (make-queue) (cons queue:tag (cons '() '())))
  29. (define (queue? obj) (and (pair? obj) (eq? queue:tag (car obj))))
  30. (define (queue-empty? obj) (null? (caar obj)))
  31.  
  32. (define (queue:queue-empty-check q) (if (queue-empty? q) (throw 'queue-empty q)))
  33. (define (queue-front q) (queue:queue-empty-check q) (cadr q))
  34. (define (queue-rear q) (queue:queue-empty-check q) (cddr q))
  35.  
  36. (define (queue-push! q d)
  37.   (let ((h (cons d (cadr q))))
  38.     (set-car! (cdr q) h)
  39.     (if (null? (cddr q))
  40.     (set-cdr! (cdr q) h))))
  41.  
  42. (define (enqueue! q d)
  43.   (let ((h (cons d '())))
  44.     (if (not (null? (cddr q)))
  45.            (set-cdr! (cddr q) h)
  46.     (set-car! (cdr q) h))
  47.     (set-cdr! (cdr q) h)))
  48.  
  49. (define (queue-pop! q)
  50.   (let ((h (queue-front q)))
  51.     (if (null? h)
  52.     (throw 'queue-empty q))
  53.     (if (null? (cdr h))
  54.     (set-cdr! (cdr q) '()))
  55.     (set-car! (cdr q) (cdr h))
  56.     (car h)))
  57.  
  58. (define dequeue! queue-pop!)
  59. (define (queue-length q) (length (cadr q)))
  60.  
  61. (provide 'queue)
  62.